Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mttext.i

Modula Implementation | 1997-10-26 | 11.7 KB | 391 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *         MAGIC   Modula's  All purpose  GEM  Interface  Cadre         *
 *                 ÿ         ÿ            ÿ    ÿ          ÿ             *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus in schrift-  *
 * licher Form, insbesondere in Zeitschriften, sowie die Verbreitung    *
 * ber Public-Domain-H„ndler bedarf der ausdrcklichen schriftlichen   *
 * Genehmigung des Autors!                                              *
 *                                                                      *
 * Der Autor gibt hiermit die ausdrckliche Erlaubnis, das Modul jeder- *
 * zeit auch im Quelltext weiterzugegeben, sofern dessen Text und ins-  *
 * besondere dieser Urheberrechts-Vermerk nicht ver„ndert wird, und     *
 * durch die Weitergabe kein finanzieller Nutzen entsteht. Der Autor    *
 * beh„lt sich das Recht vor, diese Erlaubnis jederzeit u. ohne Angaben *
 * von Grnden zu widerrufen.                                           *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtText;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *  3.01     | 02.02.92 |  Hp  | Modul um LengthLine erg„nzt            *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;








FROM Storage IMPORT ALLOCATE, DEALLOCATE;




FROM SYSTEM     IMPORT  ADDRESS, ADR, TSIZE;
FROM MagicStrings IMPORT Length, Pos, Assign, Append;
FROM mtTextfiles IMPORT TEXTFILE, Textmode, OpenTextfile, CloseTextfile,
                        Reset, EndofText, WriteLn, WriteLine, ReadLn,
                        ReadLine;


CONST   CR =            15C;
        LF =            12C;
        MaxEOL =        19;     (* max. L„nge des EondOfLine-Strings *)
        MaxStatic =     7;      (* max. L„nge des alt. statischen Strings *)


TYPE    STRING =        RECORD
                         CASE b: BOOLEAN OF
                          TRUE:  ptr: PtrString;
                                 len: lCARDINAL;|
                          FALSE: str: ARRAY [0..MaxStatic] OF CHAR;
                         END;
                        END;

TYPE    LINE =          POINTER TO Line;
        Line =          RECORD
                         string: STRING; (* Der Stringspeicher *)
                         dyn:    BOOLEAN;
                         next:   LINE;   (* N„chste Zeile *)
                         last:   LINE;   (* vorhergehende Zeile *)
                        END;

TYPE    TEXT =          POINTER TO Text;
        Text =          RECORD
                         firstline: LINE; (* Erste Zeile des Textes *)
                         lastline:  LINE; (* Letzte Zeile des Textes *)
                         eol:       ARRAY [0..MaxEOL] OF CHAR;
                                    (* EndOfLine-String, normal CR/LF *)
                        END;


PROCEDURE NewTEXT (VAR text: TEXT): BOOLEAN;
BEGIN
 ALLOCATE (text,  TSIZE (Text));
 IF text = NIL THEN RETURN FALSE;  END;
 text^.firstline:= NIL;
 text^.lastline:= NIL;
 text^.eol[0]:= CHR (0DH);
 text^.eol[1]:= CHR (0AH);
 text^.eol[2]:= CHR (00H);
 RETURN TRUE;
END NewTEXT;

PROCEDURE DisposeTEXT (VAR text: TEXT);
VAR d: LINE;
BEGIN
 IF text = NIL THEN  RETURN;  END;
 WHILE text^.firstline # NIL DO  (* Erst die Zeilen des Textes l”schen *)
  DisposeLine (text^.firstline);
 END;
 DEALLOCATE (text, 0);
 text:= NIL;
END DisposeTEXT;

PROCEDURE NewString (VAR s: STRING; REF string: ARRAY OF CHAR): INTEGER;
(* -1 = Fehlgeschlagen
 *  0 = Statischer String
 *  1 = Dynamischer String
 *)
VAR l: sCARDINAL;  i: sINTEGER;
BEGIN
 l:= Length (string);  INC (l);  i:= 0;
 IF l < MaxStatic THEN (* Kleiner als ein Pointer... *)
  Assign (string, s.str);
 ELSE
  ALLOCATE (s.ptr,  LONG(l));   (* Den Stringspeicher allozieren *)
  IF s.ptr # NIL THEN  Assign (string, s.ptr^); s.len:= LONG(l);  i:= 1;
                 ELSE  i:= -1;
  END;
 END;
 RETURN i;
END NewString;

PROCEDURE NewLine (VAR line: LINE; REF string: ARRAY OF CHAR): BOOLEAN;
VAR i: sINTEGER;
BEGIN
 line:= NIL;
 ALLOCATE (line,  TSIZE (Line));
 IF line = NIL THEN  RETURN FALSE;  END;
 i:= NewString (line^.string, string);
 IF i < 0 THEN
  DEALLOCATE (line, 0);    line:= NIL;  RETURN FALSE;
 END;
 line^.dyn:= i = 1;  line^.last:= NIL;  line^.next:= NIL;
 RETURN TRUE;
END NewLine;

PROCEDURE InsertLine (VAR text: TEXT; line, after: LINE);
BEGIN
 IF text = NIL THEN  RETURN;  END;
 IF after = NIL THEN
  (* Zeile wird erste Zeile des Textes *)
  line^.last:= NIL; (* Vorg„nger gibt es nicht! *)
  line^.next:= text^.firstline;
  IF text^.firstline # NIL THEN  text^.firstline^.last:= line;  END;
  text^.firstline:= line;
  IF text^.lastline = NIL THEN text^.lastline:= text^.firstline;  END;
 ELSIF (after = text^.lastline) THEN
  (* An Text anh„ngen *)
  line^.last:= text^.lastline;
  line^.next:= NIL; (* Gibt keinen Nachfolger *)
  text^.lastline^.next:= line;
  text^.lastline:= line;
 ELSE (* Zeile zwischendrin einfgen *)
  line^.last:= after;
  line^.next:= after^.next;
  after^.next:= line;
 END;
END InsertLine;

PROCEDURE InsertText (VAR text, insert: TEXT; after: LINE);
VAR d: LINE;
BEGIN
 IF (text = NIL) OR (insert = NIL) THEN  RETURN;  END;
 IF (insert^.firstline = NIL) THEN  RETURN;  END;
 IF after = NIL THEN
  d:= text^.firstline;
  text^.firstline:= insert^.firstline;
  insert^.lastline^.next:= d;
  d^.last:= insert^.lastline;
 ELSIF (after = text^.lastline) THEN
  text^.lastline^.next:= insert^.firstline;
  insert^.firstline^.last:= text^.lastline;
  text^.lastline:= insert^.lastline;
 ELSE (* Zeile zwischendrin einfgen *)
  after^.next^.last:= insert^.lastline;
  insert^.lastline^.next:= after^.next;
  after^.next:= insert^.firstline;
 END;
 insert^.firstline:= NIL;
 insert^.lastline:= NIL;
END InsertText;

PROCEDURE PutLine (line: LINE; REF string: ARRAY OF CHAR): BOOLEAN;
VAR i: sINTEGER;
    s: STRING;
BEGIN
 IF line # NIL THEN
  i:= NewString (s, string);
  IF i < 0 THEN  RETURN FALSE;  END;
  line^.dyn:= i = 1;
  IF line^.dyn THEN
   DEALLOCATE (line^.string.ptr, 0);
   line^.string.ptr:= s.ptr;
   line^.string.len:= s.len;
  ELSE
   Assign (string, line^.string.str);
  END;
  RETURN TRUE;
 END;
 RETURN FALSE;
END PutLine;

PROCEDURE GetLine (line: LINE; VAR string: ARRAY OF CHAR);
BEGIN
 IF line # NIL THEN
  IF line^.dyn THEN  Assign (line^.string.ptr^, string);
               ELSE  Assign (line^.string.str, string);
  END;
 END;
END GetLine;

PROCEDURE GetLinePtr (line: LINE): PtrString;
BEGIN
 IF line # NIL THEN
  IF line^.dyn THEN  RETURN line^.string.ptr;
               ELSE  RETURN ADR (line^.string.str);
  END;
 END;
 RETURN NIL;
END GetLinePtr;

PROCEDURE LengthLine (line: LINE): sCARDINAL;
BEGIN
 IF line # NIL THEN
  IF line^.dyn THEN  RETURN SHORT (line^.string.len - 1);
               ELSE  RETURN Length (line^.string.str);
  END;
 END;
END LengthLine;

PROCEDURE DisposeLine (VAR line: LINE);
BEGIN
 IF line # NIL THEN
  IF line^.last # NIL THEN  line^.last^.next:= line^.next;  END;
  IF line^.next # NIL THEN  line^.next^.last:= line^.last;  END;
  IF line^.dyn THEN  DEALLOCATE (line^.string.ptr, 0);    END;
  DEALLOCATE (line, 0);
  line:= NIL;
 END;
END DisposeLine;

PROCEDURE FirstLine (text: TEXT): LINE;
BEGIN
 IF text # NIL THEN  RETURN text^.firstline;  END;
 RETURN NIL;
END FirstLine;

PROCEDURE LastLine (text: TEXT): LINE;
BEGIN
 IF text # NIL THEN  RETURN text^.lastline;  END;
 RETURN NIL;
END LastLine;

PROCEDURE NextLine (line: LINE): LINE;
BEGIN
 IF line # NIL THEN  RETURN line^.next;  END;
 RETURN NIL;
END NextLine;

PROCEDURE PrevLine (line: LINE): LINE;
BEGIN
 IF line # NIL THEN  RETURN line^.last;  END;
 RETURN NIL;
END PrevLine;

PROCEDURE NilLine (): LINE;
BEGIN
 RETURN NIL;
END NilLine;

PROCEDURE GetNumber (text: TEXT): lCARDINAL;
VAR d: LINE;
    l: lCARDINAL;
BEGIN
 l:= 0;
 IF text # NIL THEN
  d:= text^.firstline;
  WHILE d # NIL DO  INC (l);  d:= d^.next;  END;
 END;
 RETURN l;
END GetNumber;

PROCEDURE FindNumber (text: TEXT; num: lCARDINAL): LINE;
VAR l: lCARDINAL;
    d: LINE;
BEGIN
 d:= NIL;
 IF text # NIL THEN
  l:= 1;  d:= text^.firstline;
  WHILE (d # NIL) AND (l < num) DO  d:= d^.next;  INC (l);  END;
 END;
 RETURN d;
END FindNumber;

PROCEDURE FindPos (text: TEXT; REF search: ARRAY OF CHAR; start: LINE;
                   dir: SearchDir; VAR pos: sCARDINAL): LINE;
VAR d: LINE;
    l: sCARDINAL;
BEGIN
 d:= NIL;
 IF text # NIL THEN
  d:= start;
  WHILE (d # NIL) DO
   IF d^.dyn THEN
    l:= SHORT (d^.string.len);
    pos:= Pos (search, d^.string.ptr^, 0, FALSE);
   ELSE
    l:= Length (d^.string.str);
    pos:= Pos (search, d^.string.str, 0, FALSE);
   END;
   IF pos > l THEN  d:= d^.next;  ELSE  RETURN d;  END;
  END;
 END;
 RETURN NIL;
END FindPos;

PROCEDURE ReadText (VAR text: TEXT; REF file: ARRAY OF CHAR): sINTEGER;
VAR str:   ARRAY [0..MaxLength] OF CHAR;
    tfile: TEXTFILE;
    line:  LINE;
BEGIN
 IF text # NIL THEN
  IF OpenTextfile (file, READ, 2048, tfile) THEN
   WHILE NOT EndofText (tfile) DO
    ReadLine (tfile, str);  ReadLn (tfile);
    IF NewLine (line, str) THEN
     InsertLine (text, line, text^.lastline);
    ELSE
     RETURN -1;
    END;
   END;
   CloseTextfile (tfile);
   RETURN 0;
  END;
 END;
 RETURN -1;
END ReadText;

PROCEDURE WriteText (text: TEXT; REF file: ARRAY OF CHAR): sINTEGER;
VAR tfile: TEXTFILE;
    line:  LINE;
BEGIN
 IF text # NIL THEN
  IF OpenTextfile (file, WRITE, 2048, tfile) THEN
   line:= FirstLine (text);
   WHILE line # NIL DO
    IF line^.dyn THEN  WriteLine (tfile, line^.string.ptr^);
                 ELSE  WriteLine (tfile, line^.string.str);
    END;
    WriteLine (tfile, text^.eol);
    line:= line^.next;
   END;
   CloseTextfile (tfile);
   RETURN 0;
  END;
 END;
 RETURN -1;
END WriteText;

PROCEDURE SetEndOfLine (text: TEXT; REF string: ARRAY OF CHAR);
BEGIN
 IF text # NIL THEN  Assign (string, text^.eol);  END;
END SetEndOfLine;

END mtText.